home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Context / Preserve.pm
Encoding:
Perl POD Document  |  2008-01-15  |  4.2 KB  |  170 lines
  1. package Context::Preserve;
  2. use strict;
  3. use warnings;
  4. use Carp;
  5.  
  6. use base 'Exporter';
  7. our @EXPORT = qw(preserve_context);
  8.  
  9. our $VERSION = '0.01';
  10.  
  11. sub preserve_context(&@) {
  12.     my $orig = shift;
  13.     my %args = @_;
  14.  
  15.     my $replace = $args{replace};
  16.     my $after   = $args{after};
  17.     
  18.     croak 'need an "after" or "replace" coderef'
  19.       unless $replace || $after;
  20.     
  21.     if(!defined wantarray){
  22.         $orig->();
  23.         if($after){
  24.             $after->();
  25.         }
  26.         else {
  27.             $replace->();
  28.         }
  29.         return;
  30.     }
  31.     elsif(wantarray){
  32.         my @result  = $orig->();
  33.         if($after){
  34.             my @ignored = $after->(@result);
  35.         }
  36.         else {
  37.             @result = $replace->(@result);
  38.         }
  39.         return @result;
  40.     }
  41.     else {
  42.         my $result  = $orig->();
  43.         if($after){
  44.             my $ignored = $after->($result);
  45.         }
  46.         else {
  47.             $result = $replace->($result);
  48.         }
  49.         return $result;
  50.     }
  51. }
  52.  
  53. 1;
  54. __END__
  55.  
  56. =head1 NAME
  57.  
  58. Context::Preserve - run code after a subroutine call, preserving the context the subroutine would have seen if it were the last statement in the caller
  59.  
  60. =head1 SYNOPSIS
  61.  
  62. Have you ever written this?
  63.   
  64.     my ($result, @result);
  65.  
  66.     # run a sub in the correct context
  67.     if(!defined wantarray){
  68.         some::code();
  69.     }
  70.     elsif(wantarray){
  71.         @result = some::code();
  72.     }
  73.     else {
  74.         $result = some::code();
  75.     }
  76.   
  77.     # do something after some::code
  78.     $_ += 42 for (@result, $result);
  79.   
  80.     # finally return the correct value
  81.     if(!defined wantarray){
  82.         return;
  83.     }
  84.     elsif(wantarray){
  85.         return @result;
  86.     }
  87.     else {
  88.         return $result;
  89.     }
  90.  
  91. Now you can just write this instead:
  92.  
  93.   use Context::Preserve;
  94.  
  95.   return preserve_context { some::code() }
  96.              after => sub { $_ += 42 for @_ };
  97.  
  98. =head1 DESCRIPTION
  99.  
  100. Sometimes you need to call a function, get the results, act on the
  101. results, then return the result of the function.  This is painful
  102. because of contexts; the original function can behave different if
  103. it's called in void, scalar, or list context.  You can ignore the
  104. various cases and just pick one, but that's fragile.  To do things
  105. right, you need to see which case you're being called in, and then
  106. call the function in that context.  This results in 3 code paths,
  107. which is a pain to type in (and maintain).
  108.  
  109. This module automates the process.  You provide a coderef that is the
  110. "original function", and another coderef to run after the original
  111. runs.  You can modify the return value (aliased to @_) here, and do
  112. whatever else you need to do.  C<wantarray> is correct inside both
  113. coderefs; in "after", though, the return value is ignored and the
  114. value C<wantarray> returns is related to the context that the original
  115. function was called in.
  116.  
  117. =head1 EXPORT
  118.  
  119. C<preserve_context>
  120.  
  121. =head1 FUNCTIONS
  122.  
  123. =head2 preserve_context { original } [after|replace] => sub { after }
  124.  
  125. Invokes C<original> in the same context as C<preserve_context> was
  126. called in, save the results, runs C<after> in the same context, then
  127. returns the result of C<original> (or C<after> if C<replace> is used).
  128.  
  129. If the second argument is C<after>, then you can modify C<@_> to
  130. affect the return value.  C<after>'s return value is ignored.  
  131.  
  132. If the second argument is C<replace>, then modifying C<@_> doesn't do
  133. anything.  The return value of C<after> is returned from
  134. C<preserve_context> instead.
  135.  
  136. Run C<preserve_context> like this:
  137.  
  138.   sub whatever {
  139.       ...
  140.       return preserve_context { orginal_function() }
  141.                  after => sub { modify @_          };
  142.   }
  143.  
  144.   or
  145.  
  146.   sub whatever {
  147.       ...
  148.       return preserve_context   { orginal_function() }
  149.                  replace => sub { return @new_return };
  150.   }
  151.   
  152.  
  153. Note that there's no comma between the first block and the C<< after
  154. => >> part.  This is how perl parses functions with the C<(&@)>
  155. prototype.  The alternative is to say:
  156.  
  157.       preserve_context(sub { original }, after => sub { after }); 
  158.  
  159. You can pick the one you like, but I think the first version is much
  160. prettier.
  161.  
  162. =head1 AUTHOR AND COPYRIGHT
  163.  
  164. Jonathan Rockway C<< <jrockway@cpan.org> >>
  165.  
  166. Copyright (c) 2008 Infinity Interactive.  You may redistribute this
  167. module under the same terms as Perl itself.
  168.  
  169.  
  170.